home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / toolkit / riruf1 / ruftime.bas < prev    next >
Encoding:
BASIC Source File  |  1994-09-20  |  3.2 KB  |  136 lines
  1. Option Explicit
  2.  
  3. 'Subroutine: ValidateDate   Author: A.Pasho
  4. '                           Date 8/8/94
  5. 'Description: Determines if the string is a
  6. 'valid date
  7. Function ValidateDate (sCtrl As MaskEdbox) As Integer
  8.     Dim nYear%, nMonth%, nDay%, bError%, nYear2%
  9.     Dim sDate$
  10.  
  11.     sDate = sCtrl.text
  12.     'break the string into month, day, year values
  13.     ValidateDate = False
  14.     nYear = Val(Right$(sDate, 4))
  15.     nMonth = Val(Left$(sDate, 2))
  16.     nDay = Val(Mid$(sDate, 4, 2))
  17.  
  18.     'check to see if each value has the correct number of
  19.     'digits
  20.     If Len(Str$(nYear)) < 4 Then
  21.         InformUser "Incomplete Year!"
  22.         Exit Function
  23.     End If
  24.  
  25.     If Len(Str$(nMonth)) < 2 Then
  26.         InformUser "Incomplete Month!"
  27.         Exit Function
  28.     End If
  29.  
  30.     If Len(Str$(nDay)) < 2 Then
  31.         InformUser "Incomplete Day"
  32.         Exit Function
  33.     End If
  34.  
  35.     'check the month range
  36.     If nMonth < 1 Or nMonth > 12 Then
  37.         InformUser "Invalid Month!"
  38.         Exit Function
  39.     End If
  40.  
  41.     bError = False
  42.     Select Case nMonth
  43.  
  44.     'check the number of days
  45.     '31 days
  46.     Case 1, 3, 5, 7, 8, 10, 12:
  47.         If nDay < 1 Or nDay > 31 Then
  48.             bError = True
  49.         End If
  50.  
  51.     '28 - 29 days
  52.     Case 2:
  53.         'check for leap year
  54.         If (nYear Mod 4) = 0 Then
  55.             If (nYear Mod 100) = 0 Then
  56.                 If (nYear Mod 400) = 0 Then
  57.                     If nDay < 1 Or nDay > 29 Then
  58.                         bError = True
  59.                     End If
  60.                 Else
  61.                     If nDay < 1 Or nDay > 28 Then
  62.                         bError = True
  63.                     End If
  64.                 End If
  65.             Else
  66.                 If nDay < 1 Or nDay > 29 Then
  67.                     bError = True
  68.                 End If
  69.             End If
  70.         Else
  71.             If nDay < 1 Or nDay > 28 Then
  72.                 bError = True
  73.             End If
  74.         End If
  75.  
  76.  
  77.     '30 days
  78.     Case 4, 6, 9, 11:
  79.         If nDay < 1 Or nDay > 30 Then
  80.             bError = True
  81.         End If
  82.  
  83.     End Select
  84.  
  85.     If bError Then
  86.         InformUser "Invalid Day!"
  87.         ValidateDate = False
  88.         Exit Function
  89.     End If
  90.  
  91.     ValidateDate = True
  92.  
  93. End Function
  94.  
  95. 'Subroutine: ValidateTime   Author: A.Pasho
  96. '                           Date 8/8/94
  97. 'Description: Determines if the string is a
  98. 'valid time
  99. Function ValidateTime (sTime As String) As Integer
  100.     Dim nHour%, nMin%, sM$
  101.     Dim bError%
  102.  
  103.     'break the string into hour & minute values
  104.     ValidateTime = False
  105.     nHour = Val(Left$(sTime, 2))
  106.     nMin = Val(Mid$(sTime, 4, 2))
  107.     sM = Right$(sTime, 2)
  108.  
  109.     'check the hour range
  110.     If nHour < 0 Or nHour > 12 Then
  111.         InformUser "Invalid Hour"
  112.         Exit Function
  113.     End If
  114.  
  115.     'check the minute range
  116.     If nMin < 0 Or nMin > 59 Then
  117.         InformUser "Invalid Hour"
  118.         Exit Function
  119.     End If
  120.  
  121.     'check form AM or PM
  122.     sM = UCase$(sM)
  123.     If StrComp(sM, "AM", 0) = 0 Then
  124.         ValidateTime = True
  125.         Exit Function
  126.     Else
  127.         If StrComp(sM, "PM", 0) = 0 Then
  128.             ValidateTime = True
  129.             Exit Function
  130.         End If
  131.     End If
  132.     InformUser "Time must include AM or PM."
  133.  
  134. End Function
  135.  
  136.